home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue30 / bdeorx / BDEDORX.ZIP / RestAuto / AutoRes1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-12-08  |  21.2 KB  |  699 lines
  1. unit AutoRes1;
  2. {
  3. *********************************************************
  4. *  demo for use of def files with local tables at your  *
  5. *  client's site                                        *
  6. *                                                       *
  7. *  (c) 1996-97 Reinhard Kalinke                         *
  8. *                                                       *
  9. *********************************************************
  10. }
  11.  
  12. {NOTE When compiling the samples or a project of your own using 
  13. BDEDoRxS methods with Delphi 1 tests seem to indicate that you 
  14. better increase stack size to 24 or even 32k.}
  15.  
  16. (*
  17. This demo takes a number of start params so that it can be 'controlled'
  18. by the calling app. Order and meaning of params are:
  19.  
  20. Alias          (string, either holding an alias or a directory path)
  21. DoDeleteDefs   (either 0 or 1, determining whether def files are deleted
  22.                after processing)
  23. DoCreateTables (either 0 or 1, determining whether non-existing tables
  24.                 will be created)
  25. DoIndices      (either 0 or 1, determining whether indices are processed)
  26. DoRefInt       (either 0 or 1, determining whether refint checks are processed)
  27. DoValchecks    (either 0 or 1, determining whether valchecks are processed)
  28. IndicesOnly    (either 0 or 1, determining whether only indices will be processed)
  29.  
  30. A typical call for a 'full-featured' restructure without deleting def files
  31. would look like this:
  32.  
  33. WinExecAndWait('<path>AUTOREST.EXE MyAlias 0 1 1 1 1 0',SW_SHOW);
  34.  
  35. You need to specify all start params, otherwise this sample would give an
  36. error message!
  37.  
  38. Below is code for WinExecAndWait routines for 16 and 32bit:
  39.  
  40. function WinExecAndWait(FileName: String; Visibility: Word): Word;
  41. var { by Pat Ritchey }
  42.   zAppName:array[0..512] of char;
  43.   InstanceID: THandle;
  44.   Msg: TMsg;
  45. begin
  46.   StrPCopy(zAppName,FileName);
  47.   InstanceID := WinExec(zAppName, Visibility);
  48.   if InstanceID < 32 then { a value less than 32 indicates an Exec error }
  49.     Result := -1
  50.   else
  51.   begin
  52.     repeat
  53.       while PeekMessage(Msg, 0, 0, 0, pm_Remove) do
  54.       begin
  55.         if Msg.Message = wm_Quit then Halt(Msg.WParam);
  56.         TranslateMessage(Msg);
  57.         DispatchMessage(Msg);
  58.       end;
  59.     until GetModuleUsage(InstanceID) = 0;
  60.     Result := 0;
  61.   end;
  62. end;
  63.  
  64. function WinExecAndWait32(FileName: String; Visibility: integer):integer;
  65. var  { by Pat Ritchey }
  66.   zAppName:array[0..512] of char;
  67.   zCurDir:array[0..255] of char;
  68.   WorkDir:String;
  69.   StartupInfo:TStartupInfo;
  70.   ProcessInfo:TProcessInformation;
  71. begin
  72.   StrPCopy(zAppName,FileName);
  73.   GetDir(0,WorkDir);
  74.   StrPCopy(zCurDir,WorkDir);
  75.   FillChar(StartupInfo,Sizeof(StartupInfo),#0);
  76.   StartupInfo.cb := Sizeof(StartupInfo);
  77.   StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  78.   StartupInfo.wShowWindow := Visibility;
  79.   if not CreateProcess(nil,
  80.     zAppName,                      { pointer to command line string }
  81.     nil,                           { pointer to process security attributes }
  82.     nil,                           { pointer to thread security attributes }
  83.     false,                         { handle inheritance flag }
  84.     CREATE_NEW_CONSOLE or          { creation flags }
  85.     NORMAL_PRIORITY_CLASS,
  86.     nil,                           { pointer to new environment block }
  87.     nil,                           { pointer to current directory name }
  88.     StartupInfo,                   { pointer to STARTUPINFO }
  89.     ProcessInfo) then Result := -1 { pointer to PROCESS_INF }
  90.   else
  91.   begin
  92.     WaitforSingleObject(ProcessInfo.hProcess,INFINITE);
  93.     GetExitCodeProcess(ProcessInfo.hProcess,Result);
  94.     CloseHandle( ProcessInfo.hProcess );
  95.     CloseHandle( ProcessInfo.hThread );
  96.     Result := 0;
  97.   end;
  98. end;
  99.  
  100. *)
  101.  
  102. interface
  103.  
  104. uses
  105.   WinTypes, WinProcs, Messages, SysUtils, Classes, Graphics, Controls,
  106.   Forms, Dialogs, StdCtrls, FileCtrl, Db, DBTables, Px7Table,
  107.   IniFiles, ExtCtrls,
  108.   {$IFDEF WIN32}
  109.   ComCtrls,
  110.   {$ELSE}
  111.   Gauges,
  112.   {$ENDIF}
  113.   DBIProcs;
  114.  
  115. type
  116.   TMainForm = class(TForm)
  117.     AbortBtn: TButton;
  118.     RestTbl: TPx7Table;
  119.     RestDB: TDatabase;
  120.     Panel1: TPanel;
  121.     Panel2: TPanel;
  122.     Label1: TLabel;
  123.     procedure FormShow(Sender: TObject);
  124.     procedure FormCreate(Sender: TObject);
  125.     procedure AbortBtnClick(Sender: TObject);
  126.     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  127.       Y: Integer);
  128.     procedure AbortBtnMouseMove(Sender: TObject; Shift: TShiftState; X,
  129.       Y: Integer);
  130.   private
  131.     { Private-Deklarationen }
  132.     FCalced: boolean;
  133.     FBDEVersion: string;
  134.     FPreventSizing: boolean;
  135.     FDeleteVals: boolean;
  136.     FAtWork: boolean;
  137.     FAbort: boolean;
  138.     FDirectory: TFileName;
  139.     {$IFDEF WIN32}
  140.     ProgressBar1: TProgressBar;
  141.     {$ELSE}
  142.     ProgressBar1: TGauge;
  143.     {$ENDIF}
  144.     procedure DoIt;
  145.     procedure WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
  146.               message WM_GETMINMAXINFO;
  147.     procedure WMNCHitTest(var Msg: TWMNCHitTest);
  148.               message WM_NCHitTest;
  149.     procedure WMInitMenuPopup(var Msg: TWMInitMenuPopup);
  150.               message WM_INITMENUPOPUP;
  151.   public
  152.     { Public-Deklarationen }
  153.   end;
  154.  
  155. var
  156.   MainForm: TMainForm;
  157.  
  158. implementation
  159.  
  160. {$R *.DFM}
  161.  
  162. uses BDEDoRxS;
  163.  
  164. procedure AssignDBDir(ADataBase: TDataBase; const AFileName: TFileName);
  165. begin
  166.   with ADataBase do
  167.   if (Params.Count = 0)
  168.   or (Params[0] <> 'PATH='+AFileName) then
  169.   begin
  170.     if Connected then Connected := False;
  171.     DriverName := 'STANDARD'; {clears any alias as well}
  172.     Params.Clear;
  173.     Params.Add('PATH='+AFileName);
  174.     Open;
  175.   end;
  176. end;
  177.  
  178. {'Wrappers' you might want to paste into your apps/restructors.
  179.  For an example on how to use them check form method DoItBtnClick}
  180.  
  181. {scans a dir for files with extension AExt and writes them
  182.  into a list for further processing}
  183. function DoScanDirForFiles(const ADir,AExt: TFileName;
  184.                            AList: TStrings): integer;
  185. var FileRec: TSearchRec;
  186.     ScanDir: TFileName;
  187.     Res: integer;
  188. begin
  189.   AList.Clear;
  190.   if (ADir[Length(ADir)] <> '\') then ScanDir := ADir+'\'
  191.   else ScanDir := ADir;
  192.   Res := SysUtils.FindFirst(ADir+'*.'+AExt, 0, FileRec);
  193.   while Res = 0 do
  194.   begin
  195.     AList.Add(ScanDir+FileRec.Name);
  196.     Res := SysUtils.FindNext(FileRec);
  197.   end;
  198.   SysUtils.FindClose(FileRec);
  199.   Result := AList.Count;
  200. end;
  201.  
  202. {processes table defs with thw whole range of current
  203.  options (indices, RI, Val)}
  204. procedure DoRestructureFromFile(AFileList: TStrings;
  205.                                 ADataBase: TDataBase;
  206.                                 ATable: TTable;
  207.                                 {$IFDEF WIN32}
  208.                                 AProgressBar: TProgressBar;
  209.                                 {$ELSE}
  210.                                 AProgressBar: TGauge;
  211.                                 {$ENDIF}
  212.                                 AStatusPanel: TPanel;
  213.                                 const DoCreateTables,
  214.                                 DoCreateIndices,
  215.                                 DoCreateRefInt,
  216.                                 DoCreateValchecks,
  217.                                 DoDeleteDefs: boolean);
  218. var i,iProg,iPass,iPasses: integer;
  219.     DefFile, DBFile: TFileName;
  220.     DoIndex: boolean;
  221.     ActionStr: string;
  222. begin
  223.   Screen.Cursor := crHourGlass;
  224.   try
  225.     DoIndex := DoCreateIndices;
  226.     if (DoCreateRefInt or DoCreateValchecks) then
  227.       iPasses := 2 else iPasses := 1;
  228.     {$IFDEF WIN32}
  229.     AProgressBar.Max := AFileList.Count*(1+ord(DoIndex));
  230.     {$ELSE}
  231.     AProgressBar.MaxValue := AFileList.Count*(1+ord(DoIndex));
  232.     {$ENDIF}
  233.     for iPass:=1 to iPasses do
  234.     begin
  235.       iProg := 0;
  236.       {$IFDEF WIN32}
  237.       AProgressBar.Position := 0;
  238.       {$ELSE}
  239.       AProgressBar.Progress := 0;{}
  240.       {$ENDIF}
  241.       if (iPass = 1) then
  242.         ActionStr := 'processing: '
  243.       else
  244.         ActionStr := 'creating RI and/or ValChecks: ';
  245.       for i:=0 to pred(AFileList.Count) do
  246.       begin
  247.         DefFile := AFileList.Strings[i];
  248.         with TIniFile.Create(DefFile) do
  249.         try
  250.           ATable.TableName := ReadString('Table','Name','');
  251.           AStatusPanel.Caption := ActionStr+ATable.TableName;
  252.           AStatusPanel.Update;
  253.           if (iPass = 2) then
  254.           begin
  255.             ATable.Open;
  256.             {'Bugfix' BDE4.0:}
  257.             if MainForm.FDeleteVals then
  258.               BDEDropValFile(ATable);
  259.             if DoCreateRefInt then
  260.              {dropping existing RI is included
  261.               with below function}
  262.               BDEAddRIFromFile(ATable, DefFile);
  263.             inc(iProg);
  264.             {$IFDEF WIN32}
  265.             AProgressBar.Position := iProg;
  266.             {$ELSE}
  267.             AProgressBar.Progress := iProg;{}
  268.             {$ENDIF}
  269.             if DoCreateValchecks then
  270.              {dropping existing val is included
  271.               with below function}
  272.               BDEAddValchecksFromFile(ATable, DefFile); {}
  273.             inc(iProg);
  274.             {$IFDEF WIN32}
  275.             AProgressBar.Position := iProg;
  276.             {$ELSE}
  277.             AProgressBar.Progress := iProg;{}
  278.             {$ENDIF}
  279.             Continue;
  280.           end
  281.           else
  282.           try
  283.             ATable.Open;
  284.             if DoCreateRefInt then
  285.               BDEDropAllRIConstraints(ATable);
  286.             if DoCreateIndices then
  287.               BDEDropAllIndices(ATable);
  288.             BDERestructTableFromFile(ATable, DefFile);
  289.             inc(iProg);
  290.             {$IFDEF WIN32}
  291.             AProgressBar.Position := iProg;
  292.             {$ELSE}
  293.             AProgressBar.Progress := iProg;{}
  294.             {$ENDIF}
  295.           except
  296.             on E:EDBEngineError do
  297.             begin
  298.               DoIndex := False;
  299.               {if table does not exist:}
  300.               if ((E.Errors[pred(E.ErrorCount)].ErrorCode = DBIERR_OSENOENT)
  301.               or (E.Errors[pred(E.ErrorCount)].ErrorCode = DBIERR_NOSUCHTABLE))
  302.               and DoCreateTables then
  303.               begin
  304.                 BDECreateTableFromFile(ADataBase, DefFile);
  305.                 inc(iProg);
  306.                 {$IFDEF WIN32}
  307.                 AProgressBar.Position := iProg;
  308.                 {$ELSE}
  309.                 AProgressBar.Progress := iProg;{}
  310.                 {$ENDIF}
  311.                 DoIndex := DoCreateIndices;
  312.                 ATable.Open;
  313.                 DBISaveChanges(ATable.Handle);
  314.               end
  315.               else raise;
  316.             end;
  317.             else raise;
  318.           end;
  319.           if DoIndex then
  320.             {dropping existing indices is included
  321.              with below function}
  322.             BDEAddIndicesFromFile(ATable, DefFile);
  323.           inc(iProg);
  324.           {$IFDEF WIN32}
  325.           AProgressBar.Position := iProg;
  326.           {$ELSE}
  327.           AProgressBar.Progress := iProg;{}
  328.           {$ENDIF}
  329.         finally
  330.           Free;
  331.           ATable.Close;
  332.         end;
  333.       end;
  334.     end;
  335.     AStatusPanel.Caption := 'Done!';
  336.     AStatusPanel.Update;
  337.   finally
  338.     Screen.Cursor := crDefault;
  339.   end;
  340.   if DoDeleteDefs then
  341.   begin
  342.     for i:=0 to pred(AFileList.Count) do
  343.       SysUtils.DeleteFile(AFileList.Strings[i]);
  344.   end;
  345. end;
  346.  
  347. {processes table defs for field restructure and indices only
  348.  (no RI or Val processing)}
  349. procedure DoSimpleRestructureFromFile(AFileList: TStringList;
  350.                                 ADataBase: TDataBase;
  351.                                 ATable: TTable;
  352.                                 {$IFDEF WIN32}
  353.                                 AProgressBar: TProgressBar;
  354.                                 {$ELSE}
  355.                                 AProgressBar: TGauge;
  356.                                 {$ENDIF}
  357.                                 AStatusPanel: TPanel;
  358.                                 const DoCreateTables,
  359.                                 DoCreateIndices,
  360.                                 DoDeleteDefs: boolean);
  361. var i,iProg: integer;
  362.     DefFile, DBFile: TFileName;
  363.     DoIndex: boolean;
  364.     Res: integer;
  365.     FileRec: TSearchRec;
  366. begin
  367.   Screen.Cursor := crHourGlass;
  368.   try
  369.     DoIndex := DoCreateIndices;
  370.     iProg := 0;
  371.     {$IFDEF WIN32}
  372.     AProgressBar.Position := 0;
  373.     AProgressBar.Max := AFileList.Count*(1+ord(DoIndex));
  374.     {$ELSE}
  375.     AProgressBar.Progress := 0;
  376.     AProgressBar.MaxValue := AFileList.Count*(1+ord(DoIndex));
  377.     {$ENDIF}
  378.     for i:=0 to pred(AFileList.Count) do
  379.     begin
  380.       DefFile := AFileList.Strings[i];
  381.       with TIniFile.Create(DefFile) do
  382.       try
  383.         ATable.TableName := ReadString('Table','Name','');
  384.         AStatusPanel.Caption := 'processing: '+ATable.TableName;
  385.         AStatusPanel.Update;
  386.         try
  387.           ATable.Open;
  388.           if DoCreateIndices then
  389.             BDEDropAllIndices(ATable);
  390.           BDERestructTableFromFile(ATable, DefFile);
  391.           inc(iProg);
  392.           {$IFDEF WIN32}
  393.           AProgressBar.Position := iProg;
  394.           {$ELSE}
  395.           AProgressBar.Progress := iProg;
  396.           {$ENDIF}
  397.         except
  398.           on E:EDBEngineError do
  399.           begin
  400.             DoIndex := False;
  401.             {if table does not exist:}
  402.             if ((E.Errors[pred(E.ErrorCount)].ErrorCode = DBIERR_OSENOENT)
  403.             or (E.Errors[pred(E.ErrorCount)].ErrorCode = DBIERR_NOSUCHTABLE))
  404.             and DoCreateTables then
  405.             begin
  406.               BDECreateTableFromFile(ADataBase, DefFile);
  407.               inc(iProg);
  408.               {$IFDEF WIN32}
  409.               AProgressBar.Position := iProg;
  410.               {$ELSE}
  411.               AProgressBar.Progress := iProg;
  412.               {$ENDIF}
  413.               DoIndex := DoCreateIndices;
  414.               ATable.Open;
  415.               DBISaveChanges(ATable.Handle);
  416.             end
  417.             else raise;
  418.           end;
  419.           else raise;
  420.         end;
  421.         if DoIndex then
  422.           BDEAddIndicesFromFile(ATable, DefFile);
  423.         inc(iProg);
  424.         {$IFDEF WIN32}
  425.         AProgressBar.Position := iProg;
  426.         {$ELSE}
  427.         AProgressBar.Progress := iProg;
  428.         {$ENDIF}
  429.         finally
  430.         Free;
  431.         ATable.Close;
  432.       end;
  433.     end;
  434.     AStatusPanel.Caption := 'Done!';
  435.     AStatusPanel.Update;
  436.   finally
  437.     Screen.Cursor := crDefault;
  438.   end;
  439.   if DoDeleteDefs then
  440.   begin
  441.     for i:=0 to pred(AFileList.Count) do
  442.       SysUtils.DeleteFile(AFileList.Strings[i]);
  443.   end;
  444. end;
  445.  
  446. {processes defs for indices only}
  447. procedure DoProcessIndicesFromFile(AFileList: TStringList;
  448.                                    ATable: TTable;
  449.                                    {$IFDEF WIN32}
  450.                                    AProgressBar: TProgressBar;
  451.                                    {$ELSE}
  452.                                    AProgressBar: TGauge;
  453.                                    {$ENDIF}
  454.                                    AStatusPanel: TPanel;
  455.                                    const DoDeleteDefs: boolean);
  456. var i,iProg,iPass,iPasses: integer;
  457.     DefFile, DBFile: TFileName;
  458.     Res: integer;
  459.     FileRec: TSearchRec;
  460. begin
  461.   Screen.Cursor := crHourGlass;
  462.   try
  463.     iProg := 0;
  464.     {$IFDEF WIN32}
  465.     AProgressBar.Position := 0;
  466.     AProgressBar.Max := AFileList.Count;
  467.     {$ELSE}
  468.     AProgressBar.Progress := 0;
  469.     AProgressBar.MaxValue := AFileList.Count;
  470.     {$ENDIF}
  471.     for i:=0 to pred(AFileList.Count) do
  472.     begin
  473.       DefFile := AFileList.Strings[i];
  474.       with TIniFile.Create(DefFile) do
  475.       try
  476.         ATable.TableName := ReadString('Table','Name','');
  477.         AStatusPanel.Caption := 'creating indices: '+ATable.TableName;
  478.         AStatusPanel.Update;
  479.         ATable.Open;
  480.         {dropping indices is included with below function}
  481.         BDEAddIndicesFromFile(ATable, DefFile);
  482.         inc(iProg);
  483.         {$IFDEF WIN32}
  484.         AProgressBar.Position := iProg;
  485.         {$ELSE}
  486.         AProgressBar.Progress := iProg;
  487.         {$ENDIF}
  488.       finally
  489.         Free;
  490.         ATable.Close;
  491.       end;
  492.     end;
  493.     AStatusPanel.Caption := 'Done!';
  494.     AStatusPanel.Update;
  495.   finally
  496.     Screen.Cursor := crDefault;
  497.   end;
  498.   if DoDeleteDefs then
  499.   begin
  500.     for i:=0 to pred(AFileList.Count) do
  501.       SysUtils.DeleteFile(AFileList.Strings[i]);
  502.   end;
  503. end;
  504.  
  505. {processes index defs for a list of files in case of
  506.  index errors ('Index out of date')}
  507. procedure DoRecoverIndicesFromFile(AFileList: TStringList;
  508.                                    ADB: TDataBase;
  509.                                    ATable: TTable;
  510.                                    {$IFDEF WIN32}
  511.                                    AProgressBar: TProgressBar;
  512.                                    {$ELSE}
  513.                                    AProgressBar: TGauge;
  514.                                    {$ENDIF}
  515.                                    AStatusPanel: TPanel;
  516.                                    const DoDeleteDefs: boolean);
  517. var i,iProg,iPass,iPasses: integer;
  518.     DefFile, DBFile: TFileName;
  519.     Res: integer;
  520.     FileRec: TSearchRec;
  521. begin
  522.   Screen.Cursor := crHourGlass;
  523.   try
  524.     iProg := 0;
  525.     {$IFDEF WIN32}
  526.     AProgressBar.Position := 0;
  527.     AProgressBar.Max := AFileList.Count;
  528.     {$ELSE}
  529.     AProgressBar.Progress := 0;
  530.     AProgressBar.MaxValue := AFileList.Count;
  531.     {$ENDIF}
  532.     for i:=0 to pred(AFileList.Count) do
  533.     begin
  534.       DefFile := AFileList.Strings[i];
  535.       with TIniFile.Create(DefFile) do
  536.       try
  537.         ATable.TableName := ReadString('Table','Name','');
  538.         AStatusPanel.Caption := 'recovering indices: '+ATable.TableName;
  539.         AStatusPanel.Update;
  540.         BDERecoverIndicesFromFile(ADB, ATable.TableName, DefFile);
  541.         inc(iProg);
  542.         {$IFDEF WIN32}
  543.         AProgressBar.Position := iProg;
  544.         {$ELSE}
  545.         AProgressBar.Progress := iProg;
  546.         {$ENDIF}
  547.       finally
  548.         Free;
  549.       end;
  550.     end;
  551.     AStatusPanel.Caption := 'Done!';
  552.     AStatusPanel.Update;
  553.   finally
  554.     Screen.Cursor := crDefault;
  555.   end;
  556.   if DoDeleteDefs then
  557.   begin
  558.     for i:=0 to pred(AFileList.Count) do
  559.       SysUtils.DeleteFile(AFileList.Strings[i]);
  560.   end;
  561. end;
  562. {end of 'wrapper' section}
  563.  
  564. procedure TMainForm.FormShow(Sender: TObject);
  565. begin
  566.   if not FCalced then
  567.   begin
  568.     CalcControlSize(self);
  569.     {$IFDEF WIN32}
  570.     FBDEVersion := BDEGetIdapi32Version;
  571.     {$ELSE}
  572.     FBDEVersion := BDEGetIdapi16Version;
  573.     {$ENDIF}
  574.     FCalced := True;
  575.     FPreventSizing := True;
  576.     DoIt;
  577.   end;
  578. end;
  579.  
  580. procedure TMainForm.DoIt;
  581. var AFileList: TStringList;
  582.     ADir: TFileName;
  583. begin
  584.   if (ParamStr(7) <> '0') and (ParamStr(7) <> '1') then
  585.     raise Exception.Create('Start-up params not complete');
  586.   if (Pos('\',ParamStr(1)) = 0) then
  587.   begin
  588.     RestDB.Close;
  589.     RestDB.Params.Clear;
  590.     RestDB.AliasName := ParamStr(1);
  591.     RestDB.Open;
  592.     ADir := BDEGetDBPath(ParamStr(1));
  593.   end
  594.   else
  595.   begin
  596.     AssignDBDir(RestDB,ParamStr(1));
  597.     ADir := ParamStr(1);
  598.   end;
  599.   FAtWork := True;
  600.   AFileList := TStringList.Create;
  601.   try
  602.     if (ParamStr(7) = '1') then
  603.     begin
  604.       if (DoScanDirForFiles(ADir,'DBX',AFileList) > 0) then
  605.         DoRecoverIndicesFromFile(AFileList,RestDB,RestTbl,
  606.                                  ProgressBar1,Panel1,
  607.                                  (ParamStr(2) = '1'))
  608.       else
  609.         ShowMessage('No files to process');
  610.     end
  611.     else
  612.     begin
  613.       if (DoScanDirForFiles(ADir,'DBI',AFileList) > 0) then
  614.         DoRestructureFromFile(AFileList,RestDB,RestTbl,ProgressBar1,Panel1,
  615.                               (ParamStr(3) = '1'),(ParamStr(4) = '1'),
  616.                               (ParamStr(5) = '1'),(ParamStr(6) = '1'),
  617.                               (ParamStr(2) = '1'))
  618.       else
  619.         ShowMessage('No files to process');
  620.     end;
  621.   finally
  622.     AFileList.Free;
  623.     AbortBtn.Tag := 1;
  624.     AbortBtn.Caption := 'Close';
  625.     FAtWork := False;
  626.     Screen.Cursor := crDefault;
  627.   end;
  628. end;
  629.  
  630. procedure TMainForm.AbortBtnClick(Sender: TObject);
  631. begin
  632.   if (AbortBtn.Tag = 0) then
  633.     FAbort := True
  634.   else
  635.     Application.Terminate;
  636. end;
  637.  
  638. procedure TMainForm.FormCreate(Sender: TObject);
  639. begin
  640.   {$IFDEF WIN32}
  641.   ProgressBar1 := TProgressBar.Create(self);
  642.   {$ELSE}
  643.   ProgressBar1 := TGauge.Create(self);
  644.   {$ENDIF}
  645.   with ProgressBar1 do
  646.   begin
  647.     Parent := Panel2;
  648.     Align := alClient;
  649.     Visible := True;
  650.   end;
  651. end;
  652.  
  653. procedure TMainForm.WMGetMinMaxInfo(var Msg: TWMGetMinMaxInfo);
  654. begin
  655.   inherited;
  656.   if FPreventSizing then
  657.     with (self), Msg.MinMaxInfo^ do
  658.     begin
  659.       ptMinTrackSize.x:= Width;
  660.       ptMaxTrackSize.x:= Width;
  661.       ptMinTrackSize.y:= Height;
  662.       ptMaxTrackSize.y:= Height;
  663.     end;
  664. end;
  665.  
  666. procedure TMainForm.WMInitMenuPopup(var Msg: TWMInitMenuPopup);
  667. begin
  668.   inherited;
  669.   if FPreventSizing and Msg.SystemMenu then
  670.   begin
  671.     EnableMenuItem(Msg.MenuPopup, SC_SIZE, MF_BYCOMMAND or MF_GRAYED);
  672.     EnableMenuItem(Msg.MenuPopup, SC_MAXIMIZE, MF_BYCOMMAND or MF_GRAYED);
  673.   end;
  674. end;
  675.  
  676. procedure TMainForm.WMNCHitTest(var Msg: TWMNCHitTest);
  677. begin
  678.   inherited;
  679.   if FPreventSizing then
  680.     with Msg do
  681.       if Result in [HTLEFT, HTRIGHT, HTBOTTOM, HTBOTTOMRIGHT,
  682.                     HTBOTTOMLEFT, HTTOP, HTTOPRIGHT, HTTOPLEFT] then
  683.          Result := longint(HTNOWHERE);
  684. end;
  685.  
  686. procedure TMainForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  687.   Y: Integer);
  688. begin
  689.   if FAtWork then Screen.Cursor := crHourGlass;
  690. end;
  691.  
  692. procedure TMainForm.AbortBtnMouseMove(Sender: TObject; Shift: TShiftState;
  693.   X, Y: Integer);
  694. begin
  695.   if FAtWork then Screen.Cursor := crDefault;
  696. end;
  697.  
  698. end.
  699.